setwd('C:/Users/Yona Rahminov/Desktop/MehirF')
MehirF<-read.csv("MehirF.csv",header = T,sep=',')
setwd('C:/Users/Yona Rahminov/Desktop/MehirF')
win.district<-read.csv("win.district.csv",header = T,sep = ',')
שרון אלון
נוי יפרח
ליאל תורג’מן
תמיר נגר
יונה רחמינוב
נציג את הערים בהם ממוקמים הדירות ומספר הדירות בכל עיר
Citys<-factor(MehirF$Location)
table(Citys)
## Citys
## Gaser a zarka Afula Akko Alfie Menashe Arava
## 1 7 20 4 2
## Ariel Ashkelon Be'er Ya'akov Beer Sheva Beit Arye
## 5 46 2 29 1
## Beit Dagan Beit Shean Beit Shemesh Beitar Illit Bnei Brak
## 4 2 15 2 5
## Carmiel Dimona Eilat Even Yehuda Gedera
## 5 17 13 2 3
## Hadera Haifa Harish Herzliya Jerusalem
## 1 3 18 3 17
## Kfar manda Kfar Yona Kiryat Gat Kiryat Malachi Kiryat Motzkin
## 1 2 4 2 7
## Kiryat Shmona Kiryat Tiv'on Kiryat Yam Kiryat Yearim Ma'ale Adumim
## 7 4 23 1 6
## Migdal Haemek Modi'in Nahaf Nahariya Nazareth Illit
## 12 2 1 22 2
## Netanya Netivot Ofakim Or Yehuda Petah Tikva
## 5 17 2 7 2
## Raanana Ramla Rishon Lezion Rosh HaAyin Sakhnin
## 2 2 13 12 4
## Sderot Shafira center shlomi Tarshiha Tel Aviv Jaffa
## 5 1 1 2 1
## Tiberias Tirat Carmel Yavne Yeruham
## 5 24 13 1
את הערים מיינו לשבעה מחוזות ברחבי הארץ בפאי נראה את החלוקה באחוזים של מספר ההגרלות לפי מחוזות
require("RColorBrewer")
## Loading required package: RColorBrewer
slices <- table(MehirF$District)
lbls <-c("Center", "Haifa", "Jerusalem", "Judea and Samaria", "North","South","Tel Aviv")
pct <- round(slices/sum(slices)*100)
lbls <- paste(lbls, pct) # add percents to labels
lbls <- paste(lbls,"%",sep="") # ad % to labels
pie(slices,labels = lbls,
main="Pie Chart of Districts")
library(leaflet)
## Warning: package 'leaflet' was built under R version 3.6.2
Hmap <- leaflet() %>%
addTiles() %>%
addMarkers(lng=34.986086, lat=32.787733, popup="Map of Haifa")
Hmap
נבצע ניתוחים סטטסטיים עבור מספר דירות שהוגרלו, מספר נרשמים, מספר זוכים והמחיר למטר מרובע
MehirSt<-subset(MehirF,select=c("Price.per.meter.","Total.winners" , "Total.subscribers." ,
"Total.published.apartments.in.the.lottery."))
library(pastecs)
## Warning: package 'pastecs' was built under R version 3.6.2
res <- stat.desc(MehirSt)
round(res, 2)
## Price.per.meter. Total.winners Total.subscribers.
## nbr.val 442.00 442.00 442.00
## nbr.null 0.00 9.00 0.00
## nbr.na 0.00 0.00 0.00
## min 3720.60 0.00 16.00
## max 18655.65 593.00 12272.00
## range 14935.05 593.00 12256.00
## sum 3902966.33 17684.00 510117.00
## median 8411.13 21.00 448.50
## mean 8830.24 40.01 1154.11
## SE.mean 117.55 2.60 87.33
## CI.mean.0.95 231.03 5.11 171.63
## var 6107493.59 2988.88 3370869.67
## std.dev 2471.33 54.67 1835.99
## coef.var 0.28 1.37 1.59
## Total.published.apartments.in.the.lottery.
## nbr.val 442.00
## nbr.null 0.00
## nbr.na 0.00
## min 1.00
## max 598.00
## range 597.00
## sum 23100.00
## median 35.50
## mean 52.26
## SE.mean 2.72
## CI.mean.0.95 5.35
## var 3274.92
## std.dev 57.23
## coef.var 1.09
תחילה נבדוק האם יש מגמת עלייה במספר הדירות המוצעות להגרלה אם הפרויקט חדש יותר
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.6.2
ggplot() + geom_line(aes(y = Total.published.apartments.in.the.lottery., x = Lottery.number..),
data = MehirF)
נציג את מספר ההגרלות שהם הגרלה ראשונה, כלומר פרויקט חדש, לצד אחוזי ההגרלות שהם הגרלות המשך
library(ggplot2)
ggplot(MehirF, aes(x=MehirF$Lottery.type , group=MehirF$District)) +
geom_bar(aes(y = ..prop.., fill = factor(..x..)), stat="count") +
geom_text(aes(label = scales::percent(..prop..),
y= ..prop.. ), stat= "count", vjust = -.5) +
labs(y = "Percent",x= "Lottery_type", fill="Type" ) +
facet_grid(~MehirF$District) +
scale_y_continuous(labels = scales::percent) +
theme(axis.text.x=element_text(angle = 45, hjust = 1))
הגרלות המשך מתבצעות כאשר לא נמסרו כל הדירות במכרז הראשון, ולכן מתבצעות הגרלות נוספות עד שכל הדירות ימסרו
:נבחין כי בכל מחוז אחוז ההגרלות המשך גבוה יותר, חוץ משני מחוזות
יהודה ושומרון וירושלים
לפיכך נסיק כי לא כל הזוכים מימשו את הזכיה ונבחן זאת בהמשך
בשלב זה נפנה למשתנה המחיר למטר מרובע ונבחן את התפלגות המחירים ברחבי הארץ
hiPr <- MehirF$Price.per.meter.
his<-hist(hiPr, breaks=10, col="lightblue", xlab="Price per meter",
main="Histogram of price with Normal Curve")
xfit<-seq(min(hiPr),max(hiPr),length=40)
yfit<-dnorm(xfit,mean=mean(hiPr),sd=sd(hiPr))
yfit <- yfit*diff(his$mids[1:2])*length(hiPr)
lines(xfit, yfit, col="purple", lwd=3)
abline(v = mean( MehirF$Price.per.meter.), col="blue", lwd=3, lty=2)
על מנת לחזק את הטענה נבצע מבחן טיב התאמה לחי בריבוע
price<- MehirF$Price.per.meter.
testHis<- chisq.test(price, y = NULL, correct = TRUE,
p = rep(1/length(price), length(price)))
testHis
##
## Chi-squared test for given probabilities
##
## data: price
## X-squared = 305021, df = 441, p-value < 2.2e-16
כעת נוסיף משתנה נוסך ונבחן האם קיים קשר בין מחיר למטר מרובי לבין המחוז
library(knitr)
library(kableExtra)
## Warning: package 'kableExtra' was built under R version 3.6.2
library(dplyr)
## Warning: package 'dplyr' was built under R version 3.6.2
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:kableExtra':
##
## group_rows
## The following objects are masked from 'package:pastecs':
##
## first, last
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
meanDistricts=aggregate(MehirF[,11:11], list(MehirF$District), mean)
dt3 <- meanDistricts[1:7, 1:2]
colnames( dt3 ) <- c( "District", "Mean_Price" )
dt3<-arrange(dt3,Mean_Price)
kable(dt3) %>%
kable_styling("striped", full_width = F) %>%
column_spec(1:2, bold = T) %>%
row_spec(5:7, bold = T, color = "white", background = "#D7261E")
| District | Mean_Price |
|---|---|
| North | 7023.937 |
| South | 7923.513 |
| Haifa | 8443.147 |
| Judea and Samaria | 9331.725 |
| Center | 10514.510 |
| Jerusalem | 12777.169 |
| Tel Aviv | 13328.274 |
לשם כך נשתמש במבחן חי בריבוע לבדיקת אי תלות
library(MASS)
## Warning: package 'MASS' was built under R version 3.6.2
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
tbl<-table(MehirF$Price.per.meter., MehirF$District)
chisq.test(tbl)
## Warning in chisq.test(tbl): Chi-squared approximation may be incorrect
##
## Pearson's Chi-squared test
##
## data: tbl
## X-squared = 2494, df = 1530, p-value < 2.2e-16
נרחיב את המחקר שלנו למשתנים נוספים ונבחן האם הם משפיעים על מספר הזוכים
:נבדוק את הגורמים המשפיעים על מספר הזוכים בהגרלה ונגדיר
\(y = \beta_{0} + \beta_{1} * x_{1} + \beta_{2} * x_{2} + \beta_{3} * x_{3}\)
\(H_{0} : \beta_{1} = \beta_{2} = ... = \beta_{k}\)
\(H_{1} : other\)
בתחתית סיכום המודל P-value ואת ערך ה F על מנת לנתח את הרגרסיה המרובה תחילה נבחן את נתוני ה
numericDistrict <- as.numeric(MehirF$District)
fit<- lm(Total.winners ~ numericDistrict + Actual.number.of.apartments.in.the.lottery + MehirF$Total.subscribers., MehirF)
summary(fit)
##
## Call:
## lm(formula = Total.winners ~ numericDistrict + Actual.number.of.apartments.in.the.lottery +
## MehirF$Total.subscribers., data = MehirF)
##
## Residuals:
## Min 1Q Median 3Q Max
## -84.045 -11.125 1.928 10.613 120.769
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) -10.997827 3.044015 -3.613
## numericDistrict 1.182016 0.597584 1.978
## Actual.number.of.apartments.in.the.lottery 0.702879 0.023338 30.118
## MehirF$Total.subscribers. 0.008024 0.000734 10.931
## Pr(>|t|)
## (Intercept) 0.000338 ***
## numericDistrict 0.048556 *
## Actual.number.of.apartments.in.the.lottery < 2e-16 ***
## MehirF$Total.subscribers. < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 24.21 on 438 degrees of freedom
## Multiple R-squared: 0.8052, Adjusted R-squared: 0.8039
## F-statistic: 603.4 on 3 and 438 DF, p-value: < 2.2e-16
:כדי לראות אילו ממשתני החיזוי שלנו הם משמעותיים נוכל לבחון את טבלת המקדמים שמציגה את
t statistic, p-value , \(\beta\)
summary(fit)$coefficient
## Estimate Std. Error t value
## (Intercept) -10.997827303 3.0440149033 -3.612935
## numericDistrict 1.182015877 0.5975836422 1.977992
## Actual.number.of.apartments.in.the.lottery 0.702879498 0.0233376097 30.117887
## MehirF$Total.subscribers. 0.008023718 0.0007340159 10.931259
## Pr(>|t|)
## (Intercept) 3.378525e-04
## numericDistrict 4.855585e-02
## Actual.number.of.apartments.in.the.lottery 8.964359e-109
## MehirF$Total.subscribers. 9.297260e-25
נבחן את הקשר הליניארי באמצעות גרף
qqplot(MehirF$Actual.number.of.apartments.in.the.lottery, MehirF$Total.winners, plot.it = TRUE,
xlab = deparse(substitute(Published_Apartments)),
ylab = deparse(substitute(Winners)),
main= "QQ-Plot for linear connection")
abline(0,1, col="blue", lwd=2)
דרך נוספת לראות את הקשר בין המחוזות ומספר הזוכים היא באמצעות גרף צפיפויות
library(plotly)
## Warning: package 'plotly' was built under R version 3.6.2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:MASS':
##
## select
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
p87 <- MehirF %>%
plot_ly( x = ~ District ,y = ~ MehirF$Total.winners ,split = ~District, type = 'violin',
box = list( visible = T ), meanline = list(visible = T)
) %>%
layout( xaxis = list( title = "District" ), yaxis = list( title = "Total winners",
zeroline = F ))
p87
נחזור לטענה כי לא כל הזוכים ממשים את הזכיה שלהם במחיר למשתכן ונציג זאת באמצעות הגרף
win.district<-read.csv("win.district.csv",header = T,sep = ',')
win.district<- read.csv('win.district.csv')
win.district$Percentage_of_winners_apartment
## [1] 33% 25% 29% 32% 23% 35% 22.50%
## [11]
## [21]
## Levels: 22.50% 23% 25% 29% 32% 33% 35%
library(ggplot2)
ggplot(win.district,
aes(x = win.district$District_by_winners,
y = win.district$Total_winnerByDistrict,width=.7,
label = paste0(Percentage_of_winners_apartment), "%")) +
geom_col(fill = "lightblue",
color = "lightgrey") + geom_label() +
ylab("Winners' Amount") +
xlab("District") +
ggtitle("Percentage of winners who use their win and bought an apartment")
## Warning: Removed 14 rows containing missing values (position_stack).
## Warning: Removed 14 rows containing missing values (geom_label).
בנוסף נרחיב ונבדוק את הפער בין המחיר של הדירה הראשונה במחיר למשתכן מול מחיר הדירה בשוק החופשי
נפנה לבסיס נתונים נוסף כדי להרחיב את המידע שיש בידינו בכדי לבסס את התשובה לשאלת המחקר שלנו בצורה מקיפה יותר
win.district<-read.csv("win.district.csv",header = T,sep = ',')
win.district<- read.csv('win.district.csv')
win.district$Average_price_for_the_first_apartment
## [1] 2.182 1.702 1.401 1.066 1.226 1.067 2.986 1.952 1.982 1.366 1.349 1.036
## [13] 1.911 1.366 NA NA NA NA NA NA NA
ggplot(win.district, aes(District_Average_price,
y = Average_price_for_the_first_apartment,width=.8, fill = Type_market)) +
geom_col(position = "dodge") +
geom_text(
aes(label = Average_price_for_the_first_apartment),
colour = "black", size = 4, vjust = 1.5, position = position_dodge(.9))+scale_fill_brewer(palette = "PuBu")+
ylab("price for first apartment (Millions)") + xlab("District")+ ylim(0,3.2)+
geom_label(data = win.district, aes(label = percentage_differencePrice,fontface= "bold", y = .4),vjust = 1.1)+
ggtitle("The difference between the price of the apartment and its cost on the free market",
subtitle = "(*cost in millions)" )
## Warning: Removed 7 rows containing missing values (geom_col).
## Warning: Removed 7 rows containing missing values (geom_text).
לפיכך, נבצע מבחן רגרסיה ליניארית פשוטה כדי להגיע למסקנה בנושא
\(y = \beta_{0} + \beta_{1}\)
\(H_{0} : \beta_{0} = 0\)
\(H_{1} : \beta_{0} \neq 0\)
(נבצע רגרסיה ליניארית פשוטה ונבחן האם גובה ההנחה (ההפרש בין מחיר למשתכן למחיר השוק
שניתנת לזוכים בהגרלות מחיר למשתכן תלי בשווי השוק של הדירה
כלומר, האם ביישובים בהם מחירי הדיור גבוהים יותר, ההנחה הניתנת לזכאים בתוכנית מחיר למשתכן גבוהה יותר
נציג גרף פיזור שעל צירו האנכי מחיר השוק של הדירה ועל צירו האופקי גובה ההנחה שחושבה כהפרש בין מחיר הדירה במסלול מחיר למשתכן, לבין מחיר השוק של הדירה
win.district<-read.csv("win.district.csv",header = T,sep = ',')
plot(Average_price_for_the_first_apartment ~ win.district$shekel_differencePrice, data = win.district,
xlab = "Discount (thousand ) ",ylim = c(1,3),
ylab = expression("price apartment market (thousand) "),
main = "The influence of market price on discount ammount",pch = 21, bg = "blue")
fit1 <- lm(win.district$Average_price_for_the_first_apartment ~ shekel_differencePrice, data = win.district)
abline(fit1 ,col="red")
win.district <- lm(Average_price_for_the_first_apartment ~ shekel_differencePrice,
data=win.district)
summary(win.district)
##
## Call:
## lm(formula = Average_price_for_the_first_apartment ~ shekel_differencePrice,
## data = win.district)
##
## Residuals:
## 1 3 5 7 9 11 13
## 0.355879 -0.123058 0.068584 0.005788 -0.127436 -0.129228 -0.050529
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.8262 0.1549 5.334 0.003103 **
## shekel_differencePrice 2.0832 0.2755 7.560 0.000642 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1908 on 5 degrees of freedom
## (14 observations deleted due to missingness)
## Multiple R-squared: 0.9196, Adjusted R-squared: 0.9035
## F-statistic: 57.16 on 1 and 5 DF, p-value: 0.000642
בהתאם לנתונים שאספנו בדקנו את סיכויי הזכיה של המשתתפים בהגרלה
library(plotly)
win.district <- data.frame(group=c("Center", "Haifa", "Jerusalem", "Judea and Samaria","North","Tel Aviv","South"),
FR=c(0.03, 0.05, 0.02, 0.04,0.09,0.06,0.02))
g5 <- plot_ly(win.district, labels = ~group , values = ~FR, type = 'pie') %>%
layout(title = "win chances sort by district ",
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
g5